home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 2002 #11
/
Amiga Plus CD - 2002 - No. 11.iso
/
Tools
/
Development
/
Feelin021015
/
Examples
/
03.e
< prev
next >
Wrap
Text File
|
2002-10-28
|
6KB
|
197 lines
OPT PREPROCESS
MODULE 'intuition/intuition',
'utility',
'feelin','libraries/feelin','a4'
->PROC OBJ
OBJECT localobjectdata
mode:INT
way
ENDOBJECT
ENUM FA_CrazyGauge_Mode = FCCA_BASE
ENUM FV_CrazyGauge_More,
FV_CrazyGauge_Less,
FV_CrazyGauge_TwoWays,
FV_CrazyGauge_Crary
->ENDPROC
DEF feelinbase:PTR TO feelinbase
PROC main()
DEF fcc:PTR TO feelinClass,
c,w, g,b
sys_SGlob()
IF feelinbase := OpenLibrary('feelin.library',FV_VERSION)
utilitybase := feelinbase.utility
IF fcc := F_CreateClassA([FA_SuperID, FC_Gauge,
FA_DataSize, SIZEOF localobjectdata,
FA_Dispatcher, {mDispatcher},
NIL])
c := ClientObject,
FA_Client_Title, 'Gauges_Demo',
FA_Client_Version, '$VER: Gauges_Demo 1.00 (23-09-02)',
FA_Client_Copyright, '©2000-2002, Olivier Laviale',
FA_Client_Author, 'Olivier Laviale - (lotan9@aol.com)',
FA_Client_Description, 'Show gauges & custom class',
FA_Client_Base, 'GAUGES_DEMO',
FA_Pen_Shine, 'c:FFDCA0',
FA_Pen_Fill, 'c:AA7864',
FA_Pen_Highlight, 'c:2A1E19',
Child, w := WindowObject,
FA_ID, "MAIN",
FA_Window_Title,'Feelin : Gauges',
FA_Back, FI_Fill,
Child, VGroup,
Child, g := HGroup,
Child, VGroup,
Child, Gauge(TRUE,0,100,25),
Child, Gauge(TRUE,0,100,50),
Child, Gauge(TRUE,0,100,75),
Child, Gauge(TRUE,0,100,100),
Child, F_NewObjA(fcc.id,[FA_Horizontal, TRUE,
FA_Frame, FP_Frame_Gauge,
DontChain,
FA_Numeric_Max, 100,
FA_CrazyGauge_Mode, FV_CrazyGauge_Crary,
NIL]),
End,
-> Child, Bar,
Child, BalanceObject, FA_ID,"BLNC", FA_Balance_QuickDraw, TRUE, End,
Child, VGroup, FA_FixedHeight,TRUE,
Child, F_NewObjA(fcc.id,[FA_Horizontal, TRUE,
FA_Frame, FP_Frame_Gauge,
DontChain,
FA_Numeric_Max, 100,
FA_Numeric_Value, 0,
FA_CrazyGauge_Mode, FV_CrazyGauge_TwoWays,
NIL]),
Child, F_NewObjA(fcc.id,[FA_Horizontal, TRUE,
FA_Frame, FP_Frame_Gauge,
DontChain,
FA_Numeric_Max, 100,
FA_Numeric_Value, 100,
FA_CrazyGauge_Mode, FV_CrazyGauge_TwoWays,
NIL]),
Child, F_NewObjA(fcc.id,[FA_Horizontal, TRUE,
FA_Frame, FP_Frame_Gauge,
DontChain,
FA_Numeric_Max, 100,
FA_Numeric_Value, 0,
FA_CrazyGauge_Mode, FV_CrazyGauge_TwoWays,
NIL]),
Child, F_NewObjA(fcc.id,[FA_Horizontal, TRUE,
FA_Frame, FP_Frame_Gauge,
DontChain,
FA_Numeric_Max, 100,
FA_Numeric_Value, 100,
FA_CrazyGauge_Mode, FV_CrazyGauge_TwoWays,
NIL]),
End,
End,
Child, b := TextObject,
FA_InputMode, FV_InputMode_Toggle,
FA_Fixed, TRUE,
FA_Inner, [6,3,6,3]:CHAR,
FA_Frame, 033,
FA_AltFrame, 000,
FA_Back, FI_Fill,
FA_AltBack, FI_Dark,
FA_Text, 'Toggle Gauges Look',
FA_Text_PreParse, '`Ss`Sh`<0>',
FA_Text_AltPreParse, '`Sn`<1>',
FA_Text_VCenter, TRUE,
End,
End,
FA_Window_ActiveObject, b,
End,
End
IF c
F_DoA(b,FM_Notify,[FA_Selected,FV_Notify_Always,g,5,FM_Set,FA_Gauge_Simple,FV_Notify_Value,FA_Group_Forward,TRUE])
F_DoA(w,FM_Notify,[FA_Window_CloseRequest,TRUE,FV_Notify_Client,2,FM_Client_ReturnID,FV_Client_Quit])
F_Set(w,FA_Window_Open,TRUE)
F_DoA(c,FM_Client_Run,NIL)
F_DisposeObj(c)
ENDIF
F_RemoveClass(fcc)
ENDIF
CloseLibrary(feelinbase)
ENDIF
ENDPROC
PROC mDispatcher(cl=A2:PTR TO feelinClass,obj=A0:PTR TO feelinObject,method=D0,args=A1)
DEF lod:PTR TO localobjectdata
sys_RGlob() ; lod := INST_DATA(cl,obj)
SELECT method
CASE FM_New; RETURN mNew(cl,obj,lod,args)
CASE FM_Show; F_DoA(obj,FM_ModifyHandler,[IDCMP_INTUITICKS,NIL])
CASE FM_Hide; F_DoA(obj,FM_ModifyHandler,[NIL,IDCMP_INTUITICKS])
CASE FM_HandleEvent; RETURN mHandleEvent(obj,lod,args)
DEFAULT; RETURN F_SuperDoA(cl,obj,method,args)
ENDSELECT
ENDPROC
PROC mNew(cl,obj,lod:PTR TO localobjectdata,args)
IF F_SuperDoA(cl,obj,FM_New,args)
lod.mode := GetTagData(FA_CrazyGauge_Mode,FV_CrazyGauge_More,args)
lod.way := TRUE
RETURN obj
ENDIF
ENDPROC
PROC mHandleEvent(obj,lod:PTR TO localobjectdata,he:PTR TO FS_HandleEvent)
DEF val,max,min
IF he.msg.class = IDCMP_INTUITICKS
F_DoA(obj,FM_Get,[
FA_Numeric_Value, {val},
FA_Numeric_Max, {max},
FA_Numeric_Min, {min}, NIL])
SELECT lod.mode
CASE FV_CrazyGauge_More
F_Set(obj,FA_Numeric_Value,IF val = max THEN min ELSE val + 1)
CASE FV_CrazyGauge_Less
F_Set(obj,FA_Numeric_Value,IF val = min THEN max ELSE val - 1)
CASE FV_CrazyGauge_TwoWays
IF lod.way
IF val = max
lod.way := FALSE
ELSE
F_Set(obj,FA_Numeric_Value,val + 1)
ENDIF
ELSE
IF val = min
lod.way := TRUE
ELSE
F_Set(obj,FA_Numeric_Value,val - 1)
ENDIF
ENDIF
CASE FV_CrazyGauge_Crary
F_Set(obj,FA_Numeric_Value,Rnd(max))
ENDSELECT
ENDIF
ENDPROC